perm filename III[GEM,BGB]1 blob
sn#030937 filedate 1973-03-25 generic text, type T, neo UTF8
00100 ;III DISPLAY SUBROUTINES-BGB-JANUARY 1973----------------------
00200 A←1↔B←2↔C←3
00300 INTERN BUFDPY↔BUFDPY:.+2↔=100↔BLOCK =100
00400 INTERN DPYBUF↔DPYBUF:DPYBU.↔=2048 ↔ DPYBU.: BLOCK =2048
00500 IGNORE:0↔DPYPTR:0↔BUFEND:0
00600 BUFHD:0↔0;UPG ARGUMENT. ;ADDRESS ↔ LENGTH.
00700 ;--------------------------------------------------------------
00800 INTERN DPYSET,DPYOUT,DPYBRT,AIVECT,AVECT,DPYSTR,DTYO,DPYBIG
00900 DPYSET: LAC 1,ARG1↔CDR 2,-1(1) ;BUFFER SIZE.
01000 ADDI 2,-1(1)↔DAC 2,BUFEND
01100 ADDI 1,2↔DAC 1,BUFHD ;POINT TO THIRD WORD.
01200 SETZM IGNORE
01300 CLR2: LAC A,BUFHD↔LACI B,1↔DAC B,1(A)
01400 LACI B,2(A)↔LIPI B,1(A)↔BLT B,@BUFEND
01500 PUSH P,(P)↔GO LV3
01600 ;--------------------------------------------------------------
01700 DPYBIG: SKIPE IGNORE↔POP1J
01800 LAC A,ARG1↔LACI C,46↔DPB A,[POINT 3,3,27]
01900 PUSH P,(P)↔GO LV2
02000
02100 DPYBRT: SKIPE IGNORE↔POP1J
02200 LAC 1,ARG1↔LACI C,46↔DPB A,[POINT 3,3,24]
02300 PUSH P,(P)↔GO LV2
02400 ;--------------------------------------------------------------
02500 AIVECT: SKIPA C,[146] ;INVISIBLE ABSOLUTE.
02600 AVECT: LACI C,106
02700 SKIPGE IGNORE↔POP2J
02800 LV: LAC A,ARG2↔LAC B,ARG1
02900 LVC: DPB A,[POINT 11,C,10]
03000 DPB B,[POINT 11,C,21]
03100 LV2: AOS A,DPYPTR↔DAC C,(A)
03200 LV3: LIPI A,<(<POINT 7,0,35>)>
03300 DAC A,DPYPTR↔LACI A,(A)
03400 CAML A,BUFEND↔SETOM IGNORE
03500 POP2J
03600 ;--------------------------------------------------------------
03700 DPYSTR: LAC 3,ARG1↔LIPI 3,440700
03800 ILDB 3↔JUMPE POP1J.
03900 CALL(DTYO,0)↔GO DPYSTR+2
04000
04100 DTYO: LAC 1,ARG1↔IDPB 1,DPYPTR
04200 CDR 1,DPYPTR↔CAML 1,BUFEND
04300 SETOM IGNORE↔POP1J
04400 ;--------------------------------------------------------------
04500 DPYOUT: SKIPN 1,BUFHD↔GO .+6
04600 LAC 2,DPYPTR↔DAC 2,-2(1)
04700 LACI 2,2(2)↔SUB 2,1↔DAC 2,-1(1)
04800 CDR B,DPYPTR↔SUB B,BUFHD
04900 AOS B↔DAC B,BUFHD+1
05000 LAC 1,ARG1↔DPB A,[POINT 4,.+1,12]↔703B8+BUFHD
05100 POP1J
05200 ;--------------------------------------------------------------
00100 SUBR(OCTDPY)INTEGER ----------------------------------------------
00200 BEGIN OCTDPY; OCTAL NUMBER DISPLAY.
00300 Q←←15 ↔ N←←13
00400 SKIPA↔GO L2
00500 LAC 14,ARG1↔LAC Q,[POINT 3,14,-1]↔LACI N,6
00600 L1: ILDB Q↔IORI 60↔CALL(DTYO,0)↔SOJG N,L1
00700 CALL(DTYO,[" "])
00800 L2: LAC 14,ARG1↔LAC Q,[POINT 3,14,17]↔LACI N,6
00900 L3: ILDB Q↔IORI 60↔CALL(DTYO,0)↔SOJG N,L3
01000 POP1J
01100 BEND OCTDPY; BGB 25 MARCH 1973 -----------------------------------
00100 SUBR(DECDPY)INTEGER ----------------------------------------------
00200 BEGIN DECDPY; DECIMAL NUMBER DISPLAY.
00300 LAC 1,ARG1↔POP P,ARG1 ;GET ARG AND ADJUST STACK.
00400 L1: JUMPGE 1,L2 ;TEST FOR NEGATIVE NUMBER.
00500 MOVM 2,1↔CALL(DTYO,["-"]) ;PRINT MINUS SIGN.
00600 LAC 1,2
00700 L2: IDIVI 1,12↔PUSH P,2 ;MODULO TEN AND SAVE.
00800 SKIPE 1↔PUSHJ P,L2 ;TEST FOR DONE.
00900 POP P,1↔ADDI 1,60↔CALL(DTYO,1) ;RESTORE & PRINT.
01000 POP0J
01100 BEND DECDPY; BGB 17 DECEMBER 1973 --------------------------------
01200
01300 SUBR(FLODPY)FLONUM,PLACES ----------------------------------------
01400 BEGIN FLODPY; FLOATING NUMBER DISPLAY.
01500 LAC ARG2↔JUMPL[CALL(DTYO,["-"])↔LACM ARG2↔GO .+1]
01600 LACM 2,ARG1↔CAILE 2,6↔LACI 2,6↔DAC 2,ARG1
01700 FMPR[1.↔10.↔100.↔1000.↔10000.↔100000.↔1000000.](2)↔FIXX
01800 IDIV[=1↔=10↔=100↔=1000↔=10000↔=100000↔=1000000](2)
01900 PUSH P,1↔CALL(DECDPY,0)↔POP P,0↔LAC 2,ARG1
02000 ADD[=1↔=10↔=100↔=1000↔=10000↔=100000↔=1000000](2)
02100 PUSH P,DPYPTR↔CALL(DECDPY,0)↔POP P,1
02200 LACI "."↔IDPB 0,1↔POP2J↔LIT
02300 BEND FLODPY; BGB 17 DECEMBER 1973 --------------------------------
00100 SUBR(IIIDPY)WINDOW,GLASS -----------------------------------------
00200 BEGIN IIIDPY; DISPLAY DEVICE ROUTINE.
00300 E←←16
00400
00500 ;DISPLAY WINDOW FRAME.
00600 LAC 1,ARG2
00700 NIP 1(1)↔DAC XL
00800 NAP 1(1)↔DAC XH
00900 NIP 2(1)↔DAC YL
01000 NAP 2(1)↔DAC YH
01100 CALL(DPYSET,DPYBUF)
01200 CALL(AIVECT,XL,YL)
01300 CALL(AVECT,XH,YL)
01400 CALL(AVECT,XH,YH)
01500 CALL(AVECT,XL,YH)
01600 CALL(AVECT,XL,YL)
01700
01800 ;DISPLAY THE VISIBLE EDGE LIST.
01900 LAC E,ARG2
02000 ALT2 E,E↔JUMPE E,L2 ;GET THE WORLD.
02050 PED E,E↔SKIPA ;FIRST EDGE OF WORLD.
02100 L1: ALT2 E,E↔JUMPE E,L2 ;GET AN EDGE.
02200 X1DC 1,E↔Y1DC 2,E↔CALL(AIVECT,1,2)
02300 X2DC 1,E↔Y2DC 2,E↔CALL(AVECT,1,2)
02400 GO L1
02500
02600 L2: CALL(DPYOUT,ARG1)
02700 POP2J
02800
02900 DECLARE{XL,XH,YL,YH}
03000 BEND IIIDPY; BGB 5 FEB 1973 --------------------------------------
00100 ;VERNIER III TEXT POSITIONING.
00200 VERNX ←← 14
00300 VERNY ←← 11
00400 SUBR(VDPY)V-------------------------------------------------------
00500 BEGIN VDPY;SPECIAL VERTEX DISPLAY - BGB - 9 JANUARY 1973.
00600 LAC 1,ARG1↔CAR 0,(1)↔ANDI 0,017400 ;NSEW & PZZ.
00700 SKIPE↔POP1J
00800 XDC 0,1↔FIXX↔SUBI VERNX↔PUSH P,0
00900 YDC 0,1↔FIXX↔SUBI VERNY↔PUSH P,0↔PUSHJ P,AIVECT
01000 CALL(DPYBIG,[1])↔CALL(DPYBRT,[3])
01100 CALL(IDPY,ARG1)
01200 CALL(DPYBIG,[2])↔CALL(DPYBRT,[2])
01300 POP1J
01400 BEND;2/9/73-------------------------------------------------------
01500
01600 SUBR(EDPY)E-------------------------------------------------------
01700 BEGIN EDPY;SPECIAL EDGE DISPLAY - BGB - 9 FEBRUARY 1973.
01800 CALL(DPYBIG,[1])↔CALL(DPYBRT,[3])
01900 LAC 2,ARG1
02000 PVT 1,2↔CAR 0,(1)↔ANDI 0,017400↔JUMPN L1
02100 XDC 0,1↔FIXX↔DAC X↔PUSH P,0
02200 YDC 0,1↔FIXX↔DAC Y↔PUSH P,0
02300 PUSH P,ARG1↔PUSH P,ARG1
02400 PUSHJ P,AIVECT
02500 CALL(DTYO,["+"])↔CALL(AIVECT)
02600 L1: LAC 2,ARG1
02700 NVT 1,2↔CAR 0,(1)↔ANDI 0,017400↔JUMPN L2
02800 XDC 0,1↔FIXX↔ADDM X↔PUSH P,0
02900 YDC 0,1↔FIXX↔ADDM Y↔PUSH P,0↔PUSHJ P,AVECT
03000 CALL(DTYO,["-"])
03100 L2: LAC 2,ARG1
03200 LAC X↔ASH -1↔PUSH P,0
03300 LAC Y↔ASH -1↔PUSH P,0
03400 CALL(AIVECT)↔CALL(IDPY,ARG1)
03500 CALL(DPYBIG,[2])↔CALL(DPYBRT,[2])
03600 POP1J
03700 DECLARE{X,Y}
03800 BEND;2/9/73-------------------------------------------------------
03900
00100 SUBR(FDPY)F-------------------------------------------------------
00200 BEGIN FDPY;SPECIAL FACE DISPLAY - BGB - 9 FEBRUARY 1973.
00250 EXTERN ECCW
00300 LAC 1,ARG1↔DAC 1,F
00400 TEST 1,FBIT↔POP1J
00500 PED 2,1↔DAC 2,E↔DAC 2,E0
00600 SETZM I
00700 CALL(DPYBIG,[1])
00800 CALL(DPYBRT,[3])
00900 SKIPN E↔GO[LAC 1,F↔PFACE 1,1↔PVT 1,1↔GO VDPY+1]
01000 L1: AOS I↔LAC 2,E↔TEST 2,VISIBLE↔GO L2
01100 X1DC 0,2↔DAC 0,X
01200 Y1DC 1,2↔DAC 1,Y
01300 CALL(AIVECT,0,1)↔LAC 2,E
01400 X2DC 0,2↔ADDM 0,X
01500 Y2DC 1,2↔ADDM 1,Y
01600 CALL(AVECT,0,1)
01700 LAC 0,X↔ASH 0,-1↔SUBI 0,VERNX
01800 LAC 1,Y↔ASH 1,-1↔SUBI 1,VERNY
01900 CALL(AIVECT,0,1)
02000 CALL(DECDPY,I)
02100 L2: CALL(ECCW,E,F)
02200 CAMN 1,E↔GO L3↔DAC 1,E
02300 CAME 1,E0↔GO L1
02400 L3: CALL(DPYBRT,[2])
02500 CALL(DPYBIG,[2])
02600 POP1J
02700 DECLARE{F,E,E0,X,Y,I}
02800 BEND;2/9/73-------------------------------------------------------
00100 SUBR(IDPY)NODE----------------------------------------------------
00200 BEGIN IDPY; IDENTIFIER DISPLAY.
00300 EXTERN CAMERA
00400 EXTERN NTYPE
00500 CALL(NTYPE,ARG1)↔CAIGE 1,$BODY↔GO L5
00600 LAC 1,ARG1↔SETZ 2,
00700 TESTZ 1,BBIT↔GO[
00800 SKIPE 13,-2(1)↔GO[
00900 LAC 14,-1(1)↔DZM 15
01000 CALL(DPYSTR,[13])↔POP1J]
01100 L1: CW 1,1↔TESTZ 1,BBIT↔AOJA 2,L1
01200 AOS 2↔PUSH P,2↔CALL(DTYO,["B"])
01300 CALL(DECDPY)↔POP1J]
01400 TESTZ 1,FBIT↔GO[
01500 L2: NFACE 1,1↔TESTZ 1,FBIT↔AOJA 2,L2
01600 AOS 2↔PUSH P,2↔CALL(DTYO,["F"])
01700 CALL(DECDPY)↔POP1J]
01800 TESTZ 1,EBIT↔GO[
01900 L3: NED 1,1↔TESTZ 1,EBIT↔AOJA 2,L3
02000 AOS 2↔PUSH P,2↔CALL(DTYO,["E"])
02100 CALL(DECDPY)↔POP1J]
02200 TESTZ 1,VBIT↔GO[
02300 L4: NVT 1,1↔TESTZ 1,VBIT↔AOJA 2,L4
02400 AOS 2↔PUSH P,2↔CALL(DTYO,["V"])
02500 CALL(DECDPY)↔POP1J]
02600
02700 L5: PUSH P,NNAMES(1)↔EXTERN NNAMES
02800 CALL(DPYSTR)
02900
03000 LAC 1,ARG1↔CAMN 1,UNIVERSE↔POP1J
03100 $TYPE 2,1↔DZM 5 ;NODE - TYPE - COUNT.
03200 LAC 3,UNIVERSE↔SON 3,3↔DAC 3,4 ;SON0 - SON.
03300 CAME 1,4↔GO[$TYPE 0,4↔CAMN 0,2↔AOS 5↔SIS 4,4
03400 CAME 3,4↔GO .-1↔GO .+1]↔AOS 5
03500 CALL(DECDPY,5)
03600 POP1J
03700 BEND IDPY; BGB 4 FEBRUARY 1973 -----------------------------------
03800 END